home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / dev / amos / PrgCollection.lha / Demo10.AMOS / Demo10.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1994-03-12  |  5.2 KB  |  188 lines
  1. ' *************************************
  2. ' *                                   *
  3. ' *           Demo 10 V1.0            *
  4. ' *      Written by Chris Hodges      *
  5. ' *                                   *
  6. ' *************************************
  7. '
  8. Hide 
  9. Dim REGS(10)
  10. Global GOT$,LVO,RES,LIB$,LIB,FUNK,BASE,REGS()
  11. LVO=0
  12. CLEARALL
  13. OPENLIB["exec"]
  14. LIBCALL1["exec","FindTask",0]
  15. LIBCALL2["exec","SetTaskPri",RES,20]
  16. CLOSALL
  17. Unpack 9 To 0 : Screen Hide 0
  18. For Y=0 To 5
  19.   For X=0 To 9
  20.     Get Block X+Y*10+32,X*32,Y*32,32,32,0
  21.   Next 
  22. Next 
  23. Unpack 6 To 0 : Screen Hide 0
  24. For Y=0 To 5
  25.   For X=0 To 9
  26.     Get Block X+Y*10+160,X*32,Y*32,32,32,0
  27.   Next 
  28. Next 
  29. Screen Open 2,768,32,8,0
  30. Curs Off : Flash Off : Cls 0 : Get Palette 0
  31. Screen Display 2,128,73,320,32
  32. Unpack 7 To 0 : Screen Hide 0
  33. For Y=0 To 5
  34.   For X=0 To 9
  35.     Get Block X+Y*10+288,X*32,Y*32,32,32,0
  36.   Next 
  37. Next 
  38. Screen Open 3,768,32,8,0
  39. Curs Off : Flash Off : Cls 0 : Get Palette 0
  40. Screen Display 3,128,110,320,32
  41. Screen Open 1,768,32,16,0
  42. Curs Off : Flash Off : Cls 0
  43. Screen Display 1,128,40,320,32
  44. For A=16 To 31 : Colour A,$FFF : Next 
  45. For A=8 To 15 : Colour A,0 : Next 
  46. For A=1 To 7 : Colour A,$1111-$222*A : Next 
  47. Screen Open 4,16,16,16,0
  48. Flash Off : Screen Hide 4 : Get Palette 0
  49. Unpack 8 To 0
  50. Screen Display 0,128,150,320,158
  51. For A=16 To 31 : Colour A,$FFF : Next : Screen 1
  52. Dim S$(2),D(2,3)
  53. S$(0)="HALLO! HIER IST WIEDERMAL  HOTSOFT  h5MIT EINEM NEUEN INTRO!    DREI "
  54. S$(0)=S$(0)+"SCROLLER MIT VERSCHIEDENEN GESCHWINDIGKEITEN VERMITTELN EINEN DREI "
  55. S$(0)=S$(0)+"DIMENSIONELLEN EINDRUCK!         VIEL SPASS!         "
  56. S$(1)="   LEIDER HAT DIESER ZEICHENSATZ KEINE SONDERZEICHEN  NICHT MAL NUMMERN      "
  57. S$(1)=S$(1)+"SCHADE EIGENTLICH  WO MAN SO VIEL HAETTE SCHREIBEN KOENNEN         "
  58. S$(2)="      GRUESSE AN ALLE MEINE FREUNDE, BESONDERS AN "
  59. S$(2)=S$(2)+"HENDRIK H. HEIMER, MICHAEL BERCHTOLD, MAD HENRY, MR. SNOOPY, JARO, "
  60. S$(2)=S$(2)+"HANS-PETER, RALF, WOLFGANG UND ANDREAS...            "
  61. Autoback 0 : Bob Update Off 
  62. Screen To Front 1 : Music 1 : Tempo 16
  63. Repeat 
  64.   For A=0 To 2
  65.     Screen A+1
  66.     If D(A,3)=0
  67.       Add D(A,0),A*2+4 : Add D(A,1),A*2+4
  68.       If D(A,1)>31
  69.         Add D(A,1),-32
  70.         If D(A,0)>367
  71.           Add D(A,0),-368
  72.         End If 
  73.         Gosub NL
  74.       End If 
  75.     End If 
  76.     D(A,3)=Max(D(A,3)-1,0) : Screen Offset 1+A,D(A,0)+40+A*2,
  77.     If Mouse Key=2 Then Inc D(A,3)
  78.   Next 
  79.   Wait Vbl 
  80. Until Mouse Key=1
  81. Amal Off : Sprite Off : Music Off 
  82. Screen Close 0 : Screen Close 1 : Screen Close 2 : Screen Close 3 : Screen Close 4
  83. End 
  84. NL:
  85.   Add D(A,2),1,1 To Len(S$(A)) : B=Asc(Mid$(S$(A),D(A,2),1))
  86.   If B=104 Then Inc D(A,2) : D(A,3)=Val(Mid$(S$(A),D(A,2),1))*20 : Goto NL
  87.   Put Block B+A*128,368+D(A,0)-D(A,1),0
  88.   Put Block B+A*128,D(A,0)-D(A,1),0
  89. Return 
  90. Procedure LIBCALL1[N$,F$,R1]
  91.   LIB$=N$ : LIBGET[F$]
  92.   REGS(1)=R1
  93.   LCALL
  94. End Proc
  95. Procedure LIBCALL2[N$,F$,R1,R2]
  96.   LIB$=N$ : LIBGET[F$]
  97.   REGS(1)=R1 : REGS(2)=R2
  98.   LCALL
  99. End Proc
  100. Procedure LIBGET[FUNK$]
  101.   ST=Start(15) : LIBS=Leek(ST)
  102.   LIB$=LIB$-".library"+".library"
  103.   FUNK$=Upper$(FUNK$)
  104.   For A=1 To LIBS
  105.     BIN[ST+Leek(ST+A*8-4)]
  106.     If LIB$=GOT$ Then Exit 
  107.   Next 
  108.   If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End 
  109.   If Leek(ST+A*8)=0 Then Print "FEHLER: Library nicht offen!" : End 
  110.   LIB=A
  111.   BASE=ST+Leek(ST+A*8-4)
  112.   For A=1 To Deek(BASE+24)
  113.     BIN[BASE-12+A*44-LVO*4]
  114.     If Upper$(GOT$)=FUNK$ Then Exit 
  115.   Next 
  116.   If A=Deek(BASE+24)+1 Then Print "FEHLER: Funktion nicht gefunden!" : End 
  117.   FUNK=A
  118. End Proc
  119. Procedure LCALL
  120.   For A=1 To 8
  121.     R=Peek(BASE+17+A+FUNK*44)
  122.     If R>0 Then Loke Start(14)+R*4-4,REGS(A)
  123.   Next 
  124.   OFF=-Deek(BASE+16+FUNK*44)
  125.   Loke Start(14)+60,Leek(Start(15)+LIB*8)+OFF
  126.   Loke Start(14)+56,Leek(Start(15)+LIB*8)
  127.   Call Start(14)+64
  128.   RES=Leek(Start(14))
  129. End Proc
  130. Procedure OPENLIB[N$]
  131.   If Length(15)=0
  132.     Open In 1,"LibCall.dat" : L=Lof(1) : GOT$=Input$(1,8) : Close 1
  133.     If Left$(GOT$,4)="PACK"
  134.       Reserve As Work 15,Leek(Varptr(GOT$)+4)+8
  135.       Bload "LibCall.Dat",15
  136.       A= Extension_5_00E4(Start(15)+8,L-8)
  137.       Copy Start(15)+8,Start(15)+Length(15)+8 To Start(15)
  138.     Else 
  139.       Reserve As Data 15,L
  140.       Bload "LibCall.dat",15
  141.     End If 
  142.   End If 
  143.   ST=Start(15) : LIBS=Leek(ST)
  144.   N$=N$-".library"+".library"
  145.   For A=1 To LIBS
  146.     BIN[ST+Leek(ST+A*8-4)]
  147.     If N$=GOT$ Then Exit 
  148.   Next 
  149.   If A=LIBS+1 Then Print "FEHLER: Library nicht in LibCall.Dat!" : End 
  150.   If Leek(ST+A*8)<>0 Then Pop Proc
  151.   If N$="exec.library" Then Loke ST+A*8,Leek(4) : Pop Proc
  152.   Areg(1)=ST+Leek(ST+A*8-4)
  153.   Dreg(0)=0
  154.   Loke ST+A*8,Execall(-552)
  155.   If Leek(ST+A*8)=0 Then Print "FEHLER: Library konnte nicht ge�ffnet werden!" : End 
  156. End Proc
  157. Procedure CLEARALL
  158.   If Length(15)=0 Then Pop Proc
  159.   ST=Start(15)
  160.   For A=1 To Leek(ST)
  161.     Loke ST+A*8,0
  162.   Next 
  163. End Proc
  164. Procedure CLOSALL
  165.   If Length(15)=0 Then Print "FEHLER: LibCall.Dat nicht geladen -> keine Library offen!"
  166.   ST=Start(15) : LIBS=Leek(ST)
  167.   For A=1 To LIBS
  168.     BIN[ST+Leek(ST+A*8-4)]
  169.     If(GOT$<>"exec.library") and(Leek(ST+A*8)<>0)
  170.       Areg(1)=Leek(ST+A*8)
  171.       AD=Execall(-414)
  172.       Loke ST+A*8,0
  173.     Else 
  174.       Loke ST+A*8,0
  175.     End If 
  176.   Next 
  177. End Proc
  178. Procedure GEREG[REGNUM]
  179.   RES=Leek(Start(14)+REGNUM*4)
  180. End Proc
  181. Procedure BIN[AD]
  182.   GOT$=""
  183.   Do 
  184.     CO=Peek(AD) : Inc AD
  185.     Exit If CO=0
  186.     GOT$=GOT$+Chr$(CO)
  187.   Loop 
  188. End Proc